VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsMqSeries"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'**********************************************************************'
'*                                                                    *'
'*  Program name:  Liberty MQ Out Buffer                              *'
'*                                                                    *'
'*  Description:   This file declares  all public variables for the   *'
'*                 output message buffer from the MQ General          *'
'*                 information call.                                  *'
'*                                                                    *'
'**********************************************************************'



'**********************************************************************'
'*   Private variables to the class
'**********************************************************************'

Dim gHcon As Long
Dim gHobj As Long
'Const CCHBUFFER = 30000
Const CCHBUFFER = 50000
Private rsTemp As ADODB.Recordset

'**********************************************************************'
'*   end of private variables
'**********************************************************************'

'**********************************************************************'
'*   Public variables used to connect to queues and error message
'**********************************************************************'

Public CompCode As Long      'completion code
Public Reason As Long        'reason code
Public Server_Name As String
Public Function MQ_Op_Conn(ByVal Q_M_Name As String) As Long
'Purpose
'*******
'This function connects to the specified Q manager

'Variables
'*********

'Code
'****
    On Error GoTo MQ_Op_Connfix
    'setup constants
    MQ_SETDEFAULTS
  
    'connect to the Default Queue Manager to get gHcon, CompCode and Reason
    MQCONN Q_M_Name, gHcon, CompCode, Reason
    
    MQ_Op_Conn = Reason
    
    Exit Function
MQ_Op_Connfix:
    App.LogEvent Err.Description & " clsMqseries.MQ_Op_Conn"
End Function
Public Function MQ_Put_Open(ByVal Appl_Indentity As String) As Long
'Purpose
'*******
'This function opens the q for a message to be put

'Variables
'*********
Dim O_options As Long     'open options
Dim od As MQOD            'object descriptor
Dim strSQL As String

'Code
'****
    On Error GoTo MQ_Put_OpenFix
    
dbMQPutOpen:
    If gHcon Then
        MQOD_DEFAULTS od
        
        O_options = MQOO_OUTPUT
      
        od.ObjectName = GetSettingC(csReg_RequestKey, "MQREC_OD_OBJECTNAME")              '"LQ.LCB.KEYTAXTOLCB.01"
        od.ObjectQMgrName = GetSettingC(csReg_RequestKey, "MQREC_OD_OBJECTQMGRNAME")      '"LMD1UPAP"
        od.AlternateUserId = GetSettingC(csReg_RequestKey, "MQREC_OD_ALTERNATEUSERID")    '"NULL"
        od.DynamicQName = GetSettingC(csReg_RequestKey, "MQREC_OD_DYNAMICQNAME")          '"AMQ.*"
        od.ObjectType = GetSettingC(csReg_RequestKey, "MQREC_OD_OBJECTTYPE")              '"1"

        
        mqOpen gHcon, od, O_options, gHobj, CompCode, Reason
    End If
    
    MQ_Put_Open = Reason
    Exit Function
  
MQ_Put_OpenFix:
    If Err.Number = 91 Then
        App.LogEvent "Mq could not connect to the database. clsMqSeries.MQPut"
    Else
        App.LogEvent Err.Description & " clsMqseries.MQ_Put_Open"
    End If
End Function

Public Function MQ_Put_Msg(ByVal Appl_Indentity As String, ByVal Msg As String, ByRef Correlation As String, _
                           ByRef MsgID As String, ByRef DateTime As String, _
                           ByRef MsgLen As Long) As Long
'Purpose
'*******
'This function puts a message on the Q

'Variables
'*********
    Dim md As MQMD            'message descriptor
    Dim pmo As MQPMO          'put message options
    Dim buflen As Long        'length of message to be put
    Dim buffer As String      'message to be put
    Dim strSQL As String
    Dim ret As Long
    Dim UserName As String * 25
    
'Code
'****
    On Error GoTo MQ_Put_Msgfix
dbMqPutMsg:
    
    'setup MQMD and MQPMO to their respective initial values
    MQMD_DEFAULTS md

    'Fikile 2008-04-17 changed to take values from the registry.
    
    md.ApplIdentityData = Appl_Indentity 'request key
    ret = GetUserName(UserName, 25)
    
    md.Format = GetSettingC(csReg_RequestKey, "MQREC_MD_FORMAT")                  '"MQSTR"
    md.ReplyToQ = GetSettingC(csReg_RequestKey, "MQREC_MD_REPLYTOQ")              ' "LQ.LCB.LCBTOKEYTAX.01"
    md.ReplyToQMgr = GetSettingC(csReg_RequestKey, "MQREC_MD_REPLYTOQMGR")        '"LMD1UPAP"
    md.Report = GetSettingC(csReg_RequestKey, "MQREC_MD_REPORT")                  '"0"
    md.MsgType = GetSettingC(csReg_RequestKey, "MQREC_MD_MSGTYPE")                '"8"
    md.Expiry = GetSettingC(csReg_RequestKey, "MQREC_MD_EXPIRY")                  '"-1"
    md.Feedback = GetSettingC(csReg_RequestKey, "MQREC_MD_FEEDBACK")              '"0"
    md.Encoding = GetSettingC(csReg_RequestKey, "MQREC_MD_ENCODING")              '"546"
    md.CodedCharSetId = GetSettingC(csReg_RequestKey, "MQREC_MD_CODEDCHARSETID")  '"0"
    md.Priority = GetSettingC(csReg_RequestKey, "MQREC_MD_PRIORITY")              '"-1"
    md.Persistence = GetSettingC(csReg_RequestKey, "MQREC_MD_PERSISTENCE")        '"2"
    md.PutApplType = GetSettingC(csReg_RequestKey, "MQREC_MD_PUTAPPLTYPE")        '"9"
    md.PutApplName = GetSettingC(csReg_RequestKey, "MQREC_MD_PUTAPPLNAME")        '"IML007L.DLL"
    
    MQPMO_DEFAULTS pmo
    
    pmo.Context = GetSettingC(csReg_RequestKey, "MQREC_PMO_CONTEXT")                      '"0"
    pmo.InvalidDestCount = GetSettingC(csReg_RequestKey, "MQREC_PMO_INVALIDDESTCOUNT")    '"0"
    pmo.KnownDestCount = GetSettingC(csReg_RequestKey, "MQREC_PMO_KNOWNDESTCOUNT")        '"0"
    pmo.Options = GetSettingC(csReg_RequestKey, "MQREC_PMO_OPTIONS")                      '"0"
    pmo.Timeout = GetSettingC(csReg_RequestKey, "MQREC_PMO_TIMEOUT")                      '"0"
    pmo.UnknownDestCount = GetSettingC(csReg_RequestKey, "MQREC_PMO_UNKNOWNDESTCOUNT")    '"0"
    
    buflen = Len(Msg)
    
    'Submit the message
    MQPUT gHcon, gHobj, md, pmo, buflen, Msg, CompCode, Reason
    
    'parameters to pass back
    MsgID = md.MsgID
    Correlation = md.CorrelID
    MsgLen = buflen
    DateTime = Trim(md.PutDate) & " " & Trim(md.PutTime)
    
    MQ_Put_Msg = Reason
    
'deallocate
'**********
    
    Exit Function
MQ_Put_Msgfix:
    If Err.Number = 91 Then
        'the dataconnection could be lost
        'If objMqGlobal.Database_Re_Connect Then
        '    GoTo dbMqPutMsg
        'Else
         App.LogEvent "Mq could not connect to the database. clsMqSeries.MQPut"
        'End If
    Else
        App.LogEvent Err.Description & " clsMqseries.MQ_Put_Msg"
    End If
End Function
Public Function MQ_Close_Conn() As Long
'Purpose
'*******
'This function closes the connection to the queue manager

'Variables
'*********

'Code
'****
    On Error GoTo MQ_Close_ConnFix
    'if queue manager connected successfully - then disconnect
    If gHcon Then
        MQDISC gHcon, CompCode, Reason
    End If
    MQ_Close_Conn = Reason
    Exit Function
MQ_Close_ConnFix:
   App.LogEvent Err.Description & " clsMqseries.MQ_Close_Conn"
End Function
Public Function MQ_Get_Open(ByVal GetOption As String, _
        ByVal Appl_Indentity As String) As Long
'
'Public Function MQ_Get_Open(Optional ByVal GetOption As String, _
'        Optional ByVal Appl_Indentity As String) As Long
'Purpose
'*******
'This function opens a q to get a message

'Variables
'*********
    Dim O_options As Long     'open options
    Dim od As MQOD            'object descriptor
    Dim strSQL As String
    
'Code
'****
    On Error GoTo MQ_Get_OpenFix
'    On Error GoTo eh
        
dbMqGetOpen:
  
    'if the connect was successful
    If gHcon Then
        MQOD_DEFAULTS od
        
        If UCase(Trim(GetOption)) = "P" Then
            O_options = MQOO_INPUT_AS_Q_DEF
        Else
            O_options = MQOO_BROWSE
        End If
              

        od.ObjectName = GetSettingC(csReg_RequestKey, "MQREC_OD_OBJECTNAME")              '"LQ.LCB.LCBTOKEYTAX.01"
        od.AlternateUserId = GetSettingC(csReg_RequestKey, "MQREC_OD_ALTERNATEUSERID")    '"NULL"
        od.DynamicQName = GetSettingC(csReg_RequestKey, "MQREC_OD_DYNAMICQNAME")        '"AMQ.*"
        od.ObjectQMgrName = GetSettingC(csReg_RequestKey, "MQREC_OD_OBJECTQMGRNAME")    '"LMD1UPAP"
        od.ObjectType = GetSettingC(csReg_RequestKey, "MQREC_OD_OBJECTTYPE")            '"1"
        
        mqOpen gHcon, od, O_options, gHobj, CompCode, Reason
    End If
  MQ_Get_Open = Reason
  
  Exit Function
'eh:
'  Err.Raise , Err.Number, Err.Source, Err.Description
  
'  Fikile com
MQ_Get_OpenFix:
    If Err.Number = 91 Then
        'the dataconnection could be lost
     '   If objMqGlobal.Database_Re_Connect Then
            GoTo dbMqGetOpen
      '  Else
       App.LogEvent "Mq could not connect to the database. clsMqSeries.MQPut"
       ' End If
    Else
    App.LogEvent Err.Description & " clsMqseries.MQ_Get_Open"
    End If
End Function

Public Function MQ_Get_Msg(ByRef Data As String, ByVal Appl_Indentity As String, _
    ByRef Correlation As String, ByRef MsgID As String, _
    ByVal GetOption As String) As Long
'Purpose
'*******
'This function gets a message from the q

'Variables
'*********
  Dim md As MQMD          'message desciptor
  Dim gmo As MQGMO        'get message options
  Dim buflen As Long      'length of get buffer
  'Dim buffer As String * CCHBUFFER   'got message
  Dim buffer As String * CCHBUFFER   'got message
  Dim messlen As Long     'length of returned message
  
  Dim strSQL As String
  Dim ret As Long
  Dim UserName As String * 25
  
'Code
'****
    On Error GoTo MQ_Get_MsgFix
dbMqGetMsg:
    'setup Get Message Options to the required values
    MQGMO_DEFAULTS gmo
    MQMD_DEFAULTS md
    
    If UCase(GetOption) = "P" Then
      gmo.Options = MQGMO_WAIT + MQGMO_ACCEPT_TRUNCATED_MSG + MQGMO_CONVERT
    Else
      gmo.Options = MQGMO_BROWSE_FIRST
    End If
    
    md.ApplIdentityData = Appl_Indentity 'request key
    ret = GetUserName(UserName, 25)
    md.UserIdentifier = Trim(UserName) '"mqmcomp" 'resolve from windows logon

    'Fikile 2008-04-17: Change to read values from the registry.
    '2008-04-18
    gmo.WaitInterval = GetSettingC(csReg_RequestKey, "MQREC_GMO_WAITINTERVAL")    '"5000"
    gmo.Signal1 = GetSettingC(csReg_RequestKey, "MQREC_GMO_SIGNAL1")              '"0"
    gmo.Signal2 = GetSettingC(csReg_RequestKey, "MQREC_GMO_SIGNAL2")              '"0"
    
    md.ReplyToQ = GetSettingC(csReg_RequestKey, "MQREC_MD_REPLYTOQ")              '"LQ.LCB.LCBTOKEYTAX.01"
    md.ReplyToQMgr = GetSettingC(csReg_RequestKey, "MQREC_MD_REPLYTOQMGR")        '"LMD1UPAP"
    md.Format = GetSettingC(csReg_RequestKey, "MQREC_MD_FORMAT")                  '"MQSTR"
    md.Report = GetSettingC(csReg_RequestKey, "MQREC_MD_REPORT")                  '"0"
    md.MsgType = GetSettingC(csReg_RequestKey, "MQREC_MD_MSGTYPE")                '"8"
    md.Expiry = GetSettingC(csReg_RequestKey, "MQREC_MD_EXPIRY")                  '"-1"
    md.Feedback = GetSettingC(csReg_RequestKey, "MQREC_MD_FEEDBACK")              '"0"
    md.Encoding = GetSettingC(csReg_RequestKey, "MQREC_MD_ENCODING")              '"546"
    md.CodedCharSetId = GetSettingC(csReg_RequestKey, "MQREC_MD_CODEDCHARSETID")  '"0"
    md.Priority = GetSettingC(csReg_RequestKey, "MQREC_MD_PRIORITY")              '"-1"
    md.Persistence = GetSettingC(csReg_RequestKey, "MQREC_MD_PERSISTENCE")        '"2"
    md.PutApplType = GetSettingC(csReg_RequestKey, "MQREC_MD_PUTAPPLTYPE")        '"9"
    md.PutApplName = GetSettingC(csReg_RequestKey, "MQREC_MD_PUTAPPLNAME")        '"IML007L.DLL"
    
        
    If Len(Trim(Correlation)) > 0 Then
      md.CorrelID = Correlation
    Else
      md.CorrelID = MQCI_NONE
    End If
     
    If Len(Trim(MsgID)) > 0 Then
      md.MsgID = MsgID
    Else
      md.MsgID = MQMI_NONE
    End If
   
    
  'setup length of GET buffer
  buflen = CCHBUFFER

  'get message from the queue
  MQGET gHcon, gHobj, md, gmo, buflen, buffer, messlen, CompCode, Reason
        
  'add the message to the Log listbox - ensure latest
  'message is always selected
  If CompCode <> MQCC_FAILED Then  'comp code = mqcc_failed (= 2) >Barb: break
    Data = buffer
  End If
  
  MsgID = md.MsgID
  Correlation = md.CorrelID
  MQ_Get_Msg = Reason
  
  Exit Function
MQ_Get_MsgFix:
  If Err.Number = 91 Then
  '      'the dataconnection could be lost
  '      If objMqGlobal.Database_Re_Connect Then
   ''         GoTo dbMqGetMsg
   '     Else
        App.LogEvent "Mq could not connect to the database. clsMqSeries.MQPut"
   '     End If
    Else
        App.LogEvent Err.Description & " clsMqseries.MQ_Get_Msg"
   End If
End Function

Private Sub Class_Initialize()
    Dim GetDatabaseName As Object
    Set GetDatabaseName = CreateObject("MQCall.clsReg")
    
    Server_Name = GetDatabaseName.MQDatabaseName
End Sub

Private Sub Class_Terminate()
    'Set objMqAdoConn = Nothing
End Sub
